8  Daily and Weekly Summaries

Purpose: Generate weekly summaries to use in Gg framework

8.1 Site info and daily data

Code 
# site information
siteinfo <- read_csv("C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/Data/EcoDrought_SiteInformation.csv")

# flow/yield (and temp) data 
dat <- read_csv("C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/Data/EcoDrought_FlowTempData_DailyWeekly.csv")

# add water/climate year variables and fill missing dates
dat <- add_date_variables(dat, dates = date, water_year_start = 4)
dat <- fill_missing_dates(dat, dates = date, groups = site_name)
str(dat)
tibble [292,046 × 36] (S3: tbl_df/tbl/data.frame)
 $ station_no          : chr [1:292046] NA NA NA NA ...
 $ site_name           : chr [1:292046] "Big Creek NWIS" "Big Creek NWIS" "Big Creek NWIS" "Big Creek NWIS" ...
 $ site_id             : chr [1:292046] NA NA NA NA ...
 $ basin               : chr [1:292046] NA NA NA NA ...
 $ subbasin            : chr [1:292046] NA NA NA NA ...
 $ region              : chr [1:292046] NA NA NA NA ...
 $ lat                 : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ long                : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ elev_ft             : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ area_sqmi           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ designation         : chr [1:292046] NA NA NA NA ...
 $ date                : Date[1:292046], format: "2018-01-01" "2018-01-02" ...
 $ DischargeReliability: num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ TempReliability     : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_min            : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_max            : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ tempc_mean          : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ tempc_min           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ tempc_max           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean_filled    : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean_cms       : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean_filled_cms: num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ area_sqkm           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ Yield_mm            : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ Yield_filled_mm     : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean_7         : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ flow_mean_filled_7  : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ tempc_mean_7        : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ Yield_mm_7          : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ Yield_filled_mm_7   : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ CalendarYear        : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ Month               : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ MonthName           : Factor w/ 12 levels "Apr","May","Jun",..: NA NA NA NA NA NA NA NA NA NA ...
 $ WaterYear           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...
 $ DayofYear           : num [1:292046] NA NA NA NA NA NA NA NA NA NA ...

Define G-g clusters/sub-basins

Code 
siteinfo2 <- siteinfo %>% 
  filter(!site_name %in% c("WoundedBuckCreek", "Brackett Creek", "South River Conway NWIS", 
                           "Shields River nr Livingston NWIS", "North Fork Flathead River NWIS", 
                           "Pacific Creek at Moran NWIS")) %>%
  mutate(designation = ifelse(site_name %in% c("Donner Blitzen River nr Frenchglen NWIS", 
                                               "BigCreekLower", "CoalCreekLower", "McGeeCreekLower", 
                                               "West Brook NWIS", "West Brook 0", 
                                               "Paine Run 10", "Staunton River 10", "Piney River 10", 
                                               "Shields River Valley Ranch", "Shields River ab Smith NWIS", 
                                               "EF Duck Creek be HF",
                                               "Spread Creek Dam"), "big", "little"))

Map focal sites/subbasins

Code 
siteinfo_sp <- st_as_sf(siteinfo2, coords = c("long", "lat"), crs = 4326)
mapview(siteinfo_sp, zcol = "designation")
Code 
datatable(siteinfo2 %>% 
            arrange(region, basin, subbasin, designation) %>% 
            mutate(lat = round(lat, digits = 2), 
                   long = round(long, digits = 2), 
                   area_sqmi = round(area_sqmi, digits = 2), 
                   elev_ft = round(elev_ft, digits = 0)),
          caption = "EcoDrought monitoring locations and metadata.")

8.2 View daily data

View daily time series data by sub-basin (little and medium g’s only)

8.3 Daily gG

8.3.1 Organize data

8.3.1.1 Get big and little g’s

Define focal basins

Code 
focalbasins <- c("West Brook", "Paine Run", "Staunton River", "Big Creek", "Coal Creek", "McGee Creek", "Donner Blitzen", "Shields River", "Snake River", "Duck Creek")

Recode co-located gages and designate big and little g data:

Code 
dat_day_big <- dat %>% 
  mutate(site_name = dplyr::recode(site_name, "Leidy Creek Mouth NWIS" = "Leidy Creek Mouth", "SF Spread Creek Lower NWIS" = "SF Spread Creek Lower", "Dugout Creek NWIS" = "Dugout Creek", "Shields River ab Smith NWIS" = "Shields River Valley Ranch")) %>%
  filter(site_name %in% c("Donner Blitzen River nr Frenchglen NWIS", "BigCreekLower", "CoalCreekLower", "McGeeCreekLower", "West Brook NWIS", "Paine Run 10", "Staunton River 10", "Spread Creek Dam", "Shields River Valley Ranch", "EF Duck Creek be HF"))

dat_day_little <- dat %>% 
  mutate(site_name = dplyr::recode(site_name, "Leidy Creek Mouth NWIS" = "Leidy Creek Mouth", "SF Spread Creek Lower NWIS" = "SF Spread Creek Lower", "Dugout Creek NWIS" = "Dugout Creek", "Shields River ab Smith NWIS" = "Shields River Valley Ranch")) %>%
  filter(subbasin %in% focalbasins, site_name %in% unlist(siteinfo2 %>% filter(designation == "little") %>% select(site_name)))

#c("Donner Blitzen River nr Frenchglen NWIS",  "BigCreekLower", "Big Creek NWIS", "CoalCreekLower", "McGeeCreekLower", "West Brook NWIS", "Avery Brook NWIS", "West Brook 0", "Paine Run 10", "Staunton River 10")

Big G sites

Code 
unique(dat_day_big$site_name)
 [1] "BigCreekLower"                          
 [2] "CoalCreekLower"                         
 [3] "McGeeCreekLower"                        
 [4] "West Brook NWIS"                        
 [5] "Donner Blitzen River nr Frenchglen NWIS"
 [6] "Paine Run 10"                           
 [7] "Staunton River 10"                      
 [8] "EF Duck Creek be HF"                    
 [9] "Shields River Valley Ranch"             
[10] "Spread Creek Dam"

Little g sites

Code 
unique(dat_day_little$site_name)
 [1] "Big Creek NWIS"                   "BigCreekMiddle"                  
 [3] "BigCreekUpper"                    "CoalCreekHeadwaters"             
 [5] "CoalCreekMiddle"                  "CoalCreekNorth"                  
 [7] "CycloneCreekLower"                "CycloneCreekMiddle"              
 [9] "CycloneCreekUpper"                "Hallowat Creek NWIS"             
[11] "HallowattCreekLower"              "LangfordCreekLower"              
[13] "LangfordCreekUpper"               "McGeeCreekTrib"                  
[15] "McGeeCreekUpper"                  "NicolaCreek"                     
[17] "SkookoleelCreek"                  "WernerCreek"                     
[19] "Avery Brook"                      "Avery Brook NWIS"                
[21] "Jimmy Brook"                      "Mitchell Brook"                  
[23] "Obear Brook Lower"                "Sanderson Brook"                 
[25] "West Brook Lower"                 "West Brook Reservoir"            
[27] "West Brook Upper"                 "West Whately Brook"              
[29] "Donner Blitzen ab Fish NWIS"      "Donner Blitzen ab Indian NWIS"   
[31] "Donner Blitzen nr Burnt Car NWIS" "Fish Creek NWIS"                 
[33] "Indian Creek NWIS"                "Little Blizten River NWIS"       
[35] "Paine Run 01"                     "Paine Run 02"                    
[37] "Paine Run 06"                     "Paine Run 07"                    
[39] "Paine Run 08"                     "Staunton River 02"               
[41] "Staunton River 03"                "Staunton River 06"               
[43] "Staunton River 07"                "Staunton River 09"               
[45] "EF Duck Creek ab HF"              "Henrys Fork"                     
[47] "Buck Creek"                       "Crandall Creek"                  
[49] "Deep Creek"                       "Dugout Creek"                    
[51] "Lodgepole Creek"                  "Shields River ab Dugout"         
[53] "Grizzly Creek"                    "Grouse Creek"                    
[55] "Leidy Creek Mouth"                "Leidy Creek Upper"               
[57] "NF Spread Creek Lower"            "NF Spread Creek Upper"           
[59] "Rock Creek"                       "SF Spread Creek Lower"           
[61] "SF Spread Creek Upper"

8.3.1.2 Zero flow proportion

How common is 0 flow and which sites experience drying?

Code 
paste(round((nrow(dat %>% filter(Yield_filled_mm == 0)) / nrow(dat))*100, digits = 3), "% of all flow observations are 0 cfs/yield.", sep = "")
[1] "0.025% of all flow observations are 0 cfs/yield."
Code 
dat %>% filter(Yield_filled_mm == 0) %>% group_by(site_name) %>% summarize(numdays_0flow = n()) %>% left_join(dat %>% filter(!is.na(Yield_filled_mm)) %>% group_by(site_name) %>% summarize(numdays = n())) %>% mutate(prop_0flow = numdays_0flow / numdays) %>% kable()
site_name numdays_0flow numdays prop_0flow
Jimmy Brook 13 1818 0.0071507
Mitchell Brook 4 1394 0.0028694
Obear Brook Lower 27 1800 0.0150000
Paine Run 10 8 11415 0.0007008
Staunton River 10 5 11444 0.0004369
West Brook Upper 16 1831 0.0087384

Days with zero flow are exceptionally rare in our dataset. Thus, drop all days of zero flow for downstream analysis b/c of issues associated with log transforming 0s.

8.3.1.3 Join data

Join big and little g data:

Code 
dat_day_join <- dat_day_little %>% 
  filter(Yield_filled_mm > 0 ) %>%
  select(basin, subbasin, site_name, date, Yield_filled_mm) %>% 
  rename(site_name_little = site_name, yield_little = Yield_filled_mm) %>% 
  left_join(dat_day_big %>% filter(Yield_filled_mm > 0 ) %>%
              select(basin, subbasin, site_name, date, Yield_filled_mm) %>%
              rename(site_name_big = site_name, yield_big = Yield_filled_mm)) %>%
  filter(!is.na(yield_big)) %>%
  mutate(yield_little_log = log(yield_little),
         yield_big_log = log(yield_big))
head(dat_day_join)
# A tibble: 6 × 9
  basin    subbasin  site_name_little date       yield_little site_name_big
  <chr>    <chr>     <chr>            <date>            <dbl> <chr>        
1 Flathead Big Creek Big Creek NWIS   2019-03-30        0.666 BigCreekLower
2 Flathead Big Creek Big Creek NWIS   2019-03-31        0.717 BigCreekLower
3 Flathead Big Creek Big Creek NWIS   2019-04-01        0.749 BigCreekLower
4 Flathead Big Creek Big Creek NWIS   2019-04-02        0.739 BigCreekLower
5 Flathead Big Creek Big Creek NWIS   2019-04-03        0.770 BigCreekLower
6 Flathead Big Creek Big Creek NWIS   2019-04-04        0.853 BigCreekLower
# ℹ 3 more variables: yield_big <dbl>, yield_little_log <dbl>,
#   yield_big_log <dbl>

View sample size (number of days) per site:

Code 
datatable(dat_day_join %>% group_by(subbasin, site_name_little) %>% summarize(numdays = n()),
          caption = "Sample size (number of days) per site.")

8.3.2 View gG - sites combined

Code 
dat_day_join %>% filter(subbasin == "West Brook") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Big Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Coal Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "McGee Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Paine Run") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Staunton River") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Donner Blitzen") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Snake River") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Shields River") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_day_join %>% filter(subbasin == "Duck Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

8.3.3 View gG - facet by site

Code 
dat_day_join %>% filter(subbasin == "West Brook") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3, nrow = 4)

Code 
dat_day_join %>% filter(subbasin == "Big Creek") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3, nrow = 4)

Code 
dat_day_join %>% filter(subbasin == "Coal Creek") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3)

Code 
dat_day_join %>% filter(subbasin == "McGee Creek") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Paine Run") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Staunton River") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Donner Blitzen") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Snake River") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Shields River") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_day_join %>% filter(subbasin == "Duck Creek") %>% mutate(year = as.factor(year(date))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.15) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

8.3.4 Hyteresis loops

Create plotting function

Code 
myplotfun <- function(mysite) {
  print(dat_day_join %>%
  mutate(doy = yday(date), year = year(date)) %>%
  filter(site_name_little == mysite) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = doy)) +
  geom_segment(aes(xend = c(tail(yield_big_log, n = -1), NA), 
                   yend = c(tail(yield_little_log, n = -1), NA)), 
               arrow = arrow(length = unit(0.3, "cm")), color = "black") +
  geom_point() + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  scale_color_gradient2(midpoint = 182, low = "purple3", mid = "orange", high = "purple3") +
  facet_wrap(~year))
}

8.3.4.1 West Brook

Code 
myplotfun(mysite = "Avery Brook")

Code 
myplotfun(mysite = "Avery Brook NWIS")

Code 
myplotfun(mysite = "Jimmy Brook")

Code 
myplotfun(mysite = "Mitchell Brook")

Code 
myplotfun(mysite = "Avery Brook")

Code 
myplotfun(mysite = "Obear Brook Lower")

Code 
myplotfun(mysite = "Sanderson Brook")

Code 
myplotfun(mysite = "West Brook Lower")

Code 
myplotfun(mysite = "West Brook Reservoir")

Code 
myplotfun(mysite = "West Brook Upper")

8.3.4.2 Big Creek

Code 
myplotfun(mysite = "Big Creek NWIS")

Code 
myplotfun(mysite = "BigCreekMiddle")

Code 
myplotfun(mysite = "BigCreekUpper")

Code 
myplotfun(mysite = "Hallowat Creek NWIS")

Code 
myplotfun(mysite = "HallowattCreekLower")

Code 
myplotfun(mysite = "LangfordCreekLower")

Code 
myplotfun(mysite = "LangfordCreekUpper")

Code 
myplotfun(mysite = "NicolaCreek")

Code 
myplotfun(mysite = "SkookoleelCreek")

Code 
myplotfun(mysite = "WernerCreek")

8.3.4.3 Staunton River

Code 
myplotfun(mysite = "Staunton River 02")

Code 
myplotfun(mysite = "Staunton River 03")

Code 
myplotfun(mysite = "Staunton River 06")

Code 
myplotfun(mysite = "Staunton River 07")

Code 
myplotfun(mysite = "Staunton River 09")

8.3.4.4 Shields River

Code 
myplotfun(mysite = "Buck Creek")

Code 
myplotfun(mysite = "Crandall Creek")

Code 
myplotfun(mysite = "Deep Creek")

Code 
myplotfun(mysite = "Dugout Creek")

Code 
myplotfun(mysite = "Lodgepole Creek")

Code 
myplotfun(mysite = "Shields River ab Dugout")

Color by rate of change (rising vs falling limbs)

Code 
dat_day_join %>%
  mutate(doy = yday(date), year = year(date)) %>%
  filter(site_name_little == "LangfordCreekLower") %>%
  mutate(big_deriv1 = (yield_big_log - lag(yield_big_log)) / (doy - lag(doy))) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = big_deriv1)) +
  geom_segment(aes(xend = c(tail(yield_big_log, n = -1), NA), 
                   yend = c(tail(yield_little_log, n = -1), NA)), 
               arrow = arrow(length = unit(0.3, "cm")), color = "black") +
  geom_point() + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  scale_color_continuous_diverging(palette = "Red-Green") +
  theme_dark()+
  facet_wrap(~year)

Code 
# 
# myplotfun <- function(mysite) {
#   print(dat_day_join %>%
#   mutate(doy = yday(date), year = year(date)) %>%
#   filter(site_name_little == mysite) %>%
#   ggplot(aes(x = yield_big_log, y = yield_little_log, color = doy)) +
#   geom_segment(aes(xend = c(tail(yield_big_log, n = -1), NA), 
#                    yend = c(tail(yield_little_log, n = -1), NA)), 
#                arrow = arrow(length = unit(0.3, "cm")), color = "black") +
#   geom_point() + 
#   geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
#   scale_color_gradient2(midpoint = 182, low = "purple3", mid = "orange", high = "purple3") +
#   facet_wrap(~year))
# }

8.4 Weekly gG

8.4.1 Organize data

Summarize daily data as weekly means:

Code 
dat_week <- dat %>% mutate(year = year(date), week = week(date)) %>% filter(!is.na(Yield_filled_mm)) %>% group_by(basin, subbasin, region, site_name, lat, long, elev_ft, area_sqmi, designation, year, week) %>% summarize(Yield_filled_mm_weekly = sum(Yield_filled_mm, na.rm = TRUE), n = n(), mindate = min(date), maxdate = max(date)) %>% ungroup() %>% filter(n == 7, !is.na(Yield_filled_mm_weekly))

8.4.1.1 Get big and little g’s

Designate big and little g data:

Code 
dat_week_big <- dat_week %>% 
  mutate(site_name = dplyr::recode(site_name, "Leidy Creek Mouth NWIS" = "Leidy Creek Mouth", "SF Spread Creek Lower NWIS" = "SF Spread Creek Lower", "Dugout Creek NWIS" = "Dugout Creek", "Shields River ab Smith NWIS" = "Shields River Valley Ranch")) %>%
  filter(site_name %in% c("Donner Blitzen River nr Frenchglen NWIS", "BigCreekLower", "CoalCreekLower", "McGeeCreekLower", "West Brook NWIS", "Paine Run 10", "Staunton River 10", "Spread Creek Dam", "Shields River Valley Ranch", "EF Duck Creek be HF"))

dat_week_little <- dat_week %>% 
  mutate(site_name = dplyr::recode(site_name, "Leidy Creek Mouth NWIS" = "Leidy Creek Mouth", "SF Spread Creek Lower NWIS" = "SF Spread Creek Lower", "Dugout Creek NWIS" = "Dugout Creek", "Shields River ab Smith NWIS" = "Shields River Valley Ranch")) %>%
  filter(subbasin %in% focalbasins, site_name %in% unlist(siteinfo2 %>% filter(designation == "little") %>% select(site_name)))

8.4.1.2 Zero flow proportion

How common is 0 flow and which sites experience drying?

Code 
paste(round((nrow(dat_week %>% filter(Yield_filled_mm_weekly == 0)) / nrow(dat_week))*100, digits = 3), "% of all weekly flow observations are 0 cfs/yield.", sep = "")
[1] "0.013% of all weekly flow observations are 0 cfs/yield."
Code 
dat_week %>% filter(Yield_filled_mm_weekly == 0) %>% group_by(site_name) %>% summarize(numdays_0flow = n()) %>% left_join(dat_week %>% filter(!is.na(Yield_filled_mm_weekly)) %>% group_by(site_name) %>% summarize(numdays = n())) %>% mutate(prop_0flow = numdays_0flow / numdays) %>% kable()
site_name numdays_0flow numdays prop_0flow
Jimmy Brook 1 253 0.0039526
Obear Brook Lower 2 251 0.0079681

8.4.1.3 Join data

Join big and little g data:

Code 
dat_week_join <- dat_week_little %>% 
  filter(Yield_filled_mm_weekly > 0) %>%
  select(basin, subbasin, site_name, year, week, Yield_filled_mm_weekly) %>% 
  rename(site_name_little = site_name, yield_little = Yield_filled_mm_weekly) %>% 
  left_join(dat_week_big %>% filter(Yield_filled_mm_weekly > 0) %>%
              select(basin, subbasin, site_name, year, week, Yield_filled_mm_weekly) %>%
              rename(site_name_big = site_name, yield_big = Yield_filled_mm_weekly)) %>%
  filter(!is.na(yield_big), !is.na(yield_little)) %>%
  mutate(yield_little_log = log(yield_little),
         yield_big_log = log(yield_big))
(dat_week_join)
# A tibble: 6,935 × 10
   basin        subbasin site_name_little  year  week yield_little site_name_big
   <chr>        <chr>    <chr>            <dbl> <dbl>        <dbl> <chr>        
 1 Donner Blit… Donner … Donner Blitzen …  2019    31         1.90 Donner Blitz…
 2 Donner Blit… Donner … Donner Blitzen …  2019    32         1.77 Donner Blitz…
 3 Donner Blit… Donner … Donner Blitzen …  2019    33         1.54 Donner Blitz…
 4 Donner Blit… Donner … Donner Blitzen …  2019    34         1.41 Donner Blitz…
 5 Donner Blit… Donner … Donner Blitzen …  2019    35         1.33 Donner Blitz…
 6 Donner Blit… Donner … Donner Blitzen …  2019    36         1.32 Donner Blitz…
 7 Donner Blit… Donner … Donner Blitzen …  2019    37         1.33 Donner Blitz…
 8 Donner Blit… Donner … Donner Blitzen …  2019    38         1.50 Donner Blitz…
 9 Donner Blit… Donner … Donner Blitzen …  2019    39         1.41 Donner Blitz…
10 Donner Blit… Donner … Donner Blitzen …  2019    40         1.46 Donner Blitz…
# ℹ 6,925 more rows
# ℹ 3 more variables: yield_big <dbl>, yield_little_log <dbl>,
#   yield_big_log <dbl>

View sample size (number of weeks) per site:

Code 
datatable(dat_week_join %>% group_by(subbasin, site_name_little) %>% summarize(numweeks = n()),
          caption = "Sample size (number of weeks) per site.")
Code 
unique(dat_week_join$subbasin)
 [1] "Donner Blitzen" "Duck Creek"     "Big Creek"      "Coal Creek"    
 [5] "McGee Creek"    "Paine Run"      "Shields River"  "Snake River"   
 [9] "Staunton River" "West Brook"

8.4.2 View gG - sites combined

Code 
dat_week_join %>% filter(subbasin == "West Brook") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "Big Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "Coal Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "McGee Creek") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "Paine Run") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "Staunton River") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

Code 
dat_week_join %>% filter(subbasin == "Donner Blitzen") %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, group = site_name_little, color = site_name_little)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  geom_smooth(method = "lm", se = F)

8.4.3 View gG - facet by site

Code 
dat_week_join %>% filter(subbasin == "West Brook") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3, nrow = 4)

Code 
dat_week_join %>% filter(subbasin == "Big Creek") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3, nrow = 4)

Code 
dat_week_join %>% filter(subbasin == "Coal Creek") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little, ncol = 3)

Code 
dat_week_join %>% filter(subbasin == "McGee Creek") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Paine Run") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Staunton River") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Donner Blitzen") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Snake River") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Shields River") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

Code 
dat_week_join %>% filter(subbasin == "Duck Creek") %>% mutate(year = as.factor(year)) %>%
  ggplot(aes(x = yield_big_log, y = yield_little_log, color = year)) + 
  geom_point(alpha = 0.25) + 
  geom_abline(intercept = 0, slope = 1, linetype = "dashed") + 
  #geom_smooth(method = "lm", se = F) +
  facet_wrap(~site_name_little)

8.5 Write data files

Write daily and weekly paired g-G data to file

Code 
write_csv(dat_day_join, "C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/EcoDrought-Analysis/Event Delineation/EcoDrought_Data_Daily_Paired_gG.csv")

write_csv(dat_week_join, "C:/Users/jbaldock/OneDrive - DOI/Documents/USGS/EcoDrought/EcoDrought Working/EcoDrought-Analysis/Event Delineation/EcoDrought_Data_Weekly_Paired_gG.csv")